####################################################################
# Time-stamp: <05/08/11 18:12:21 ostolop>
# package DB ... contains database related functions
####################################################################
package EP::Common::DB;

use strict;

use EP::Config;

use Time::Local;
use XML::LibXML;
use Crypt::PasswdMD5;

######################################################################
# retrieve error (err_code, message, severity) from the database,
# return as a hash reference
######################################################################
sub get_error {
  my ( $err_code ) = @_;

  my $sth = $EP::Config::h->{DBH}->prepare( "SELECT * FROM error WHERE id = ?");
  my $rc = $sth->execute( $err_code );
  return $sth->fetchrow_hashref();
}

######################################################################
# sql error wrapper.... for more informative error messages
######################################################################
sub sql_error {
  my ($err) = @_;

  if ( $err ) {
    warn "[EP::DB ERROR] $err\n";
    return 1;
  } else {
    return 0;
  }
}


######################################################################
# can get session status by either session id or query id
# session_id has priority.
######################################################################
sub get_session_status {
  my ($session_id, $query_id) = @_;
  my $session_status;

  if ( $session_id ) {
    ($session_status) = $EP::Config::h->{DBH}-> selectrow_array ( "SELECT status_message FROM session_status WHERE session_id = ?", undef, $session_id );
  } elsif ( $query_id ) {
    ($session_status) = $EP::Config::h->{DBH}-> selectrow_array ( "SELECT SS.status_message FROM session_status SS, sessions_metadata SM WHERE SS.session_id=SM.session_id AND SM.query_id=?", undef, $query_id );
  }

  return $session_status;
}

sub set_session_status {
  my ($session_id, $status_message) = @_;

  my $sth = $EP::Config::h->{DBH}->prepare ( "SELECT COUNT(*) FROM session_status WHERE session_id = ?" );
  my $rc  = $sth->execute ( $session_id );
  my ($do_update) = $sth->fetchrow_array();

  if ( $do_update ) {
    $sth = $EP::Config::h->{DBH}->prepare ( "UPDATE session_status SET status_message = ? WHERE session_id = ?" );
  } else {
    $sth = $EP::Config::h->{DBH}->prepare ( "INSERT INTO session_status (status_message, session_id) VALUES (?,?)" );
  }

  $rc  = $sth->execute ( $status_message, $session_id );
}

sub get_user {
  my ($username) = @_;

  my $sth = $EP::Config::h->{DBH}->prepare( "SELECT * FROM users WHERE username = ?");
  my $rc = $sth->execute ( $username );
  return $sth->fetchrow_hashref ();
}

######################################################################
# returns the username associated with the current session
######################################################################
sub get_username {
    my ($session_id) = @_;

    my $sth = $EP::Config::h->{DBH}->prepare( "select username from sessions_metadata where session_id = ?");
    my $rc = $sth->execute( $session_id );
    return $sth->fetchrow_array();
}

sub get_folder {
    my ($folder) = @_;
    my ($restriction, @query);

    if ( $folder->{id} !~/^\s*$/ ) {
	$restriction = "where folder_id = ?";
	push @query, $folder->{id};
    } elsif ( $folder->{name}  !~/^\s*$/ && $folder->{parent_folder}  !~/^\s*$/ ) {
	$restriction = "where folder_name = ? and parent_folder = ?";
	push @query, $folder->{name}, $folder->{parent_folder};
    } else {
	print STDERR "Don't know what to do...\n";
	return 0;
    }

    my $sth = $EP::Config::h->{DBH}->prepare( "select * from ep_folder $restriction" );
    $sth->execute(@query);
    return 0 if &sql_error($DBI::errstr) == 1;

    $folder = $sth->fetchrow_hashref();
    return $folder;
}

sub get_folder_id {
    my ($folder) = @_;

    # get the folder id where the file is
    my $sth_folder = $EP::Config::h->{DBH}->prepare( "select folder_id from ep_folder where location = ?" );
    my $rc_folder = $sth_folder->execute($folder);
    my ($folder_id) = $sth_folder->fetchrow_array();
    warn "[EP_DB] $DBI::errstr" and return if !$rc_folder;
    warn "[EP_DB] Couldn't find folder id for $folder" and return if !$folder_id;

    return $folder_id;
}

sub get_folder_location {
  my ( $folder_id ) = @_;

  my $sth = $EP::Config::h->{DBH}->prepare( "select location from ep_folder where folder_id = ?" );
  my $rc = $sth->execute ( $folder_id );
  warn $DBI::errstr and return 0 if !$rc;

  my ( $location ) = $sth->fetchrow_array();
  return $location;
}

sub insert_user {
  my ( $salt, $user_props ) = @_;

  #insert the user
  my $sth = $EP::Config::h->{DBH}->prepare( "insert into users (username,password,salt,first_name,last_name,institute,department,address,telephone,email) values (?,?,?,?,?,?,?,?,?,?)" );
  $sth->execute ( $user_props->{username},
		  unix_md5_crypt ( $user_props->{password}, $salt ),
		  $salt,
		  $user_props->{first_name},
		  $user_props->{last_name},
		  $user_props->{institute},
		  $user_props->{department},
		  $user_props->{address},
		  $user_props->{telephone},
		  $user_props->{email} );
  $sth->finish();
  
  return 1;
}

sub insert_folder {
  my ($data) = @_;

  my $sth_folder = $EP::Config::h->{DBH}->prepare ( "insert into ep_folder (folder_name, parent_folder, location, username, group_write, group_read, other_read) values (?,?,?,?,?,?,?)" );
  $sth_folder->execute ( $data->{folder_name},
			 $data->{parent_folder},
			 $data->{location},
			 $data->{username},
			 0, 1, 0 # no group write, yes group read, no other read
		       );

  return 0 if &sql_error($DBI::errstr) == 1;
  return 1;
}

######################################################################
# check whether a user is allowed to have non-session data
######################################################################
sub session_data_only {
    my ($username) = @_;

    #check whether the user has session based data only
    my $sth = $EP::Config::h->{DBH}->prepare( "select session_only from users where username = ?" );
    my $rc = $sth->execute( $username );
    warn $DBI::errstr and return 0 if !$rc;

    my $session_only = $sth->fetchrow_array();
    $sth->finish;
    
    return $session_only;
}

######################################################################
# insert dataset into the database (return new dataset id)
######################################################################
sub insert_dataset {
  my ($data) = @_;

  my $folder_id = $data->{folder_id};
  ($folder_id) = get_folder_id ( $data->{folder} ) if not $folder_id;
  return 0 if !$folder_id;

  #insert the dataset into the database
  my $sql;
  if ( ORACLE ) {
    $sql = "select dataset_seq.nextval from dual";
  } else {
    $sql = "select nextval('dataset_seq')";
  }

  my ($new_dataset_id) = $EP::Config::h->{DBH}->selectrow_array ( $sql );

  my $sth_dataset = $EP::Config::h->{DBH}->prepare ( "insert into ep_dataset (dataset_id, dataset_name, description, type, species, filename, folder_id, session_id, username, group_write, group_read, other_read) values (?,?,?,?,?,?,?,?,?,?,?,?)" );
  $sth_dataset->execute( $new_dataset_id,
			 $data->{dataset},
			 $data->{description},
			 $data->{type},
			 $data->{species},
			 $data->{filename},
			 $folder_id,
			 $data->{session},
			 $data->{username},
			 0, 0, 0 );

  return 0 if &sql_error($DBI::errstr) == 1;

  # return ref to new dataset from the DB
  my $new_dataset = get_dataset ( { id => $new_dataset_id } );

  $new_dataset->{0}->{matrix} = $data->{matrix};
  $new_dataset->{0}->{row}    = $data->{row};
  $new_dataset->{0}->{column} = $data->{column};
  $new_dataset->{0}->{stats}  = $data->{stats};

  return $new_dataset->{0};
}

######################################################################
# retrieve datasets (extended version of get_dataset) - datasets and
# their metadata are retrieved together
######################################################################
sub ex_get_dataset {
  my ($data) = @_;
  return get_dataset ( $data, "get_extended" );
}

######################################################################
# retrieve datasets from the database
# depending on what's set, the query is restricted
# if get_extended is defined, retrieve metadata, too
######################################################################
sub get_dataset {
  warn "Who wants me?";
    my ($data, $get_extended) = @_;
    my ($restriction, @query, $dataset);
    my ($count) = 0;

    if ( $data->{id} ) {
	#dataset id
	$restriction = "where dataset_id = ?";
	push @query, $data->{id};
    } elsif ( $data->{session} && $data->{folder_id} && $data->{username} && $data->{all_folders} ) {
	# "all" datasets - uploads and folder datasets
	# should think of a better way....
	$restriction = "where session_id = ? or (folder_id = ? and username = ?)";
	push @query, $data->{session}, $data->{folder_id}, $data->{username};
    } elsif ( $data->{dataset} && $data->{folder} ) {
	# certain datasets
	if ( $data->{session} ) {
	    $restriction = "where dataset_name = ? and folder = ? and session_id = ?";
	    push @query, $data->{dataset}, $data->{folder}, $data->{session};
	} else {	    
	    $restriction = "where dataset_name = ? and folder = ?";
	    push @query, $data->{dataset}, $data->{folder};
	}
    } elsif ( $data->{session} && $data->{folder_id} && $data->{username} )  {
	#session based folders
	$restriction = "where session_id = ? and folder_id = ? and username = ?";	
	push @query, $data->{session}, $data->{folder_id}, $data->{username};
    } elsif ( $data->{folder_id} && $data->{username} ) {
	#non-session based folders
	$restriction = "where folder_id = ? and username = ?";
	push @query, $data->{folder_id}, $data->{username};
     } elsif ( $data->{folder} && $data->{filename} ) {
	# search by folder and filename
	$restriction = "where folder = ? and filename = ?";
	push @query, $data->{folder}, $data->{filename};
      } else {
	print STDERR "Don't know what to do...\n";
	return;
    }

    my $sth = $EP::Config::h->{DBH}->prepare( "select * from ep_dataset_view $restriction" );
    $sth->execute(@query);
    return if &sql_error( $DBI::errstr ) == 1;

    while ( my ($id, $name, $desc, $type, $species, $session, $folder_id, $folder, $filename,
		$username, $group_write, $group_read, $other_read, $created, $last_used) 
	    = $sth->fetchrow_array() ) {
      my $metadata;
      $metadata = get_dataset_metadata_as_hash ( $id, $type ) if defined $get_extended;

      $dataset->{$count++} = { key => $id,
			       value => $name,
			       name => "dataset_src", # prob rename this... name refers to input field
			       dataset_name => $name,
			       description => $desc,
			       type => $type,
			       species => $species,
			       session => $session,
			       folder_id => $folder_id,
			       folder => $folder,
			       filename => $filename,
			       username => $username,
			       group_write => $group_write,
			       group_read => $group_read,
			       other_read => $other_read,
			       created => $created,
			       last_used => $last_used,
			       metadata => $metadata
			     };
    }
    return $dataset;
}

######################################################################
# retrieves the action_metadata for clusterings by dataset_id
######################################################################
sub get_dataset_clusterings {
  my $dataset_id = $_[0];

  my $sth = $EP::Config::h->{DBH}->prepare( "SELECT DISTINCT action_metadata FROM analysis_history WHERE component_id = 4 AND dst_dataset_id = ?" );
  $sth->execute($dataset_id);

  return $sth->fetchall_arrayref();
}

######################################################################
# inserts the metadata for the dataset $id
######################################################################
sub insert_dataset_metadata {
    my ($id, $type, $metadata) = @_;
    my ($columns);

    if ( $type eq 'exp' ) {
	$columns = "(dataset_id, histogram, mean, stdev, num_columns, num_rows, lineplot) values(?,?,?,?,?,?,?)";
    }

    my $sth = $EP::Config::h->{DBH}->prepare( "insert into ep_dataset_$type\_metadata $columns" );
    $sth->execute($id, @$metadata);

    return 0 if &sql_error ( $DBI::errstr ) == 1;
    return 1;
}

######################################################################
# updates the metadata for the dataset $id
######################################################################
sub update_dataset_metadata {
    my ($id, $type, $metadata) = @_;
    my ($columns);

    if ( $type eq 'exp' ) {
	$columns = "(dataset_id, histogram, mean, stdev, num_columns, num_rows) values(?,?,?,?,?,?)";
    }

    warn "About to update metadata for dataset $id";;

    my $sth = $EP::Config::h->{DBH}->prepare( "update dataset_$type\_metadata set histogram=?, mean=?, stdev=?, num_columns=?, num_rows=? where dataset_id=?" );
    $sth->execute(@$metadata, $id);

    return 0 if &sql_error( $DBI::errstr ) == 1;
    return 1;
}

sub get_dataset_metadata_as_hash {
  my ($id, $type) = @_;

  return get_dataset_metadata ( $id, $type, 1 );
}

sub get_dataset_metadata {
    my ($id, $type, $as_hash) = @_;

    my $sth = $EP::Config::h->{DBH}->prepare( "select * from ep_dataset_$type\_metadata where dataset_id = ?" );
    $sth->execute($id);
    return if &sql_error( $DBI::errstr ) == 1;
    return $sth->fetchrow_hashref() if defined $as_hash;
    return $sth->fetchrow_array();
}

######################################################################
# general routine that selects dynamic data from the database and 
# creates a hash table from it
######################################################################
sub get_dynamic_data {
    my ($type, $multiple_groups) = @_;
    my $dyn_data = {};
    my $seen_dyn_data = {};
    my ($prev_group) = ("");
    my ($count) = 0;

    my $sth_sel = $EP::Config::h->{DBH}->prepare( "select dyn_data_name, dyn_data_desc, dyn_data_vis, dyn_data_attrib_name, dyn_data_attrib_value, dyn_group_name, dyn_group_desc from dynamic_data_view where dyn_data_type = ? order by dyn_group_rank, dyn_data_group_rank, dyn_data_name" );

    $sth_sel->execute($type);

    while ( my ($name, $desc, $vis, $attrib_name, $attrib_value, $group_name, $group_desc) = $sth_sel->fetchrow_array() ) {
	#skip if not wanted
	next if $vis == 0;

	#add the group name if new group
	if ( defined( $multiple_groups) && $multiple_groups == 1 && $group_name ne $prev_group ) {
	    $dyn_data->{$count++} = { key => "",
				      value => $group_desc
				      } if $prev_group ne '';
	    $prev_group = $group_name;
	}
	
	#might get multiple rows per name when more then one
	#attrib name has been set
	$dyn_data->{$count} = { key => $name,
				value => $desc,
			    };
	$dyn_data->{$count}{$attrib_name} = $attrib_value if $attrib_name and $attrib_value;

	$count++ if  !$seen_dyn_data->{$name}++;
    }
    $sth_sel->finish();

    return $dyn_data;
}

######################################################################
# returns session metadata by session_id
######################################################################
sub get_session_metadata {
  my ( $session_id ) = @_;

  my $sth = $EP::Config::h->{DBH}->prepare ( "select * from sessions_metadata where session_id = ?" );
  my $rc  = $sth->execute ( $session_id );

  return 0 if &sql_error( $DBI::errstr ) == 1;
  return $sth->fetchrow_hashref();
}

######################################################################
# returns session metadata by session_id
######################################################################
sub set_session_expire {
  my ( $session_id, $expire ) = @_;

  my $sth = $EP::Config::h->{DBH}->prepare ( "update sessions_metadata set expire=? where session_id=?" );
  my $rc  = $sth->execute ( $expire, $session_id );

  return 0 if &sql_error( $DBI::errstr ) == 1;
  return 1;
}

######################################################################
# removes any datasets associated with the current session
######################################################################
sub remove_session_data {
    my ($session_id) = @_;
    
    return 0 if $session_id eq '';
    
    my $sth_del_id = $EP::Config::h->{DBH}->prepare( "delete from ep_dataset where dataset_id = ?");
    my $sth_id = $EP::Config::h->{DBH}->prepare( "select dataset_id, type, filename, folder from ep_dataset_view where session_id = ?" );
    my $rc_id = $sth_id->execute( $session_id );
    warn $DBI::errstr and return 0 if !$rc_id;

    while ( my ( $dataset_id, $type, $filename, $folder ) = $sth_id->fetchrow_array() ) {
	# remove metadata first
	my $files = $EP::Config::h->{EPNG_USRDATA_PATH} . "/$folder/$filename" . "*";
	warn "Unable to delete files associated with session\n" and return 0 if unlink ( glob($files) ) == 0;

	my $sth_del_metadata = $EP::Config::h->{DBH}->prepare( "delete from ep_dataset_$type\_metadata where dataset_id = ?");
	my $rc_del_metadata = $sth_del_metadata->execute($dataset_id);
	warn $DBI::errstr and return 0 if !$rc_del_metadata;

	my $rc_del_id = $sth_del_id->execute($dataset_id);
	warn $DBI::errstr and return 0 if !$rc_del_id;
    }

    return 1;
}

######################################################################
# removes session related information
######################################################################
sub remove_session {
  my ($session_id) = @_;

  return 0 if $session_id eq '';

  # remove session metadata
  my $sth_del_metadata = $EP::Config::h->{DBH}->prepare( "delete from sessions_metadata where session_id = ?" );
  my $rc_del_metadata = $sth_del_metadata->execute( $session_id );
  warn $DBI::errstr and return 0 if !$rc_del_metadata;

  # remove session itself
  my $sth_del = $EP::Config::h->{DBH}->prepare( "delete from sessions where id = ?");
  my $rc_del = $sth_del->execute( $session_id );
  warn $DBI::errstr and return 0 if !$rc_del;

  return 1;
}

######################################################################
# Remove the dataset from the database
# Make sure that all siblings associated with this dataset are also
# deleted
######################################################################
sub remove_dataset {
    my ($dataset_id) = @_;

    return 0 if $dataset_id eq '';

    my $sth = $EP::Config::h->{DBH}->prepare( "delete from ep_dataset where dataset_id = ?" );

    my $sth_siblings = $EP::Config::h->{DBH}->prepare( "select * from analysis_history_view where root_dataset_id = ?" );
    my $rc_siblings = $sth_siblings->execute( $dataset_id );
   
    # delete all datasets associated with this root_dataset
    while ( my $sibling = $sth_siblings->fetchrow_hashref() ) {
	$sth->execute( $sibling->{dst_dataset_id} );
	return 0 if &sql_error($DBI::errstr) == 1;
    }

    # and delete the root_dataset itself
    my $rc = $sth->execute($dataset_id);
    return 0 if &sql_error($DBI::errstr) == 1;

    return 1;
}

sub remove_action {
  my ($action_id) = @_;

  return if not $action_id;

#  my $sth = $EP::Config::h->{DBH}->prepare ( "select action_id from analysis_history where parent_action_id = ?" );
#  my $rc = $sth->execute ( $action_id );
#  while ( my ($child_action_id) = $sth->fetchrow_array() ) {
#    remove_action ( $child_action_id );
#  }

  my $sth = $EP::Config::h->{DBH}->prepare ( "delete from analysis_history where action_id = ?" );
  my $rc = $sth->execute ( $action_id );

  return 0 if sql_error ( $DBI::errstr ) == 1;
  return 1;
}

######################################################################
# Remove the folder from the database records ( relying on cascading to also delete the children )
######################################################################
sub remove_folder {
    my ($folder_id) = @_;
    
    return 0 if $folder_id eq '';

    my $sth = $EP::Config::h->{DBH}->prepare( "delete from ep_folder where folder_id = ?" );
    my $rc = $sth->execute($folder_id);
    return 0 if &sql_error($DBI::errstr) == 1;

    return 1;
}

# Sub: get_folder_tree
#   obtain the complete folder structure for a certain user
sub get_folder_tree {
  my ( $session ) = @_;

  # get all folders from the database
  my $sth = $EP::Config::h->{DBH}->prepare ( "select * from ep_folder where owner=? order by parent" );
  my $rc = $sth->execute ( $session->owner->id ) if (defined($session) && defined($session->owner));

  my ($root_folder) = $EP::Config::h->{DBH}->selectrow_array ( "select id from ep_folder where parent is null" );

  warn $DBI::errstr and return 0 if !$rc;

  my $folder_tree_xml = build_folder_tree_xml ( $sth, $session->current_folder, $root_folder );

  return $folder_tree_xml;
}

######################################################################
# builds the folder tree xml from the database records
######################################################################
sub build_folder_tree_xml
    {
    my ($sth, $cur_folder_id, $root_folder) = @_;

    my $xml_doc = XML::LibXML->createDocument();
    my $root = $xml_doc->createElement( "folder_tree" );
    $root->setAttribute( "root_folder_id", $root_folder );

    $xml_doc->setDocumentElement( $root );

    while ( my $result = $sth->fetchrow_hashref() )
        {
        my $folder = $xml_doc->createElement("folder");
        $folder->setAttribute( "id", $result->{id} );
        $folder->setAttribute( "name", $result->{name} );
        $folder->setAttribute( "location", $result->{location} );
        $folder->setAttribute( "is_current", 0 );

        if ( $result->{parent} == $root_folder )
            {
            $xml_doc->documentElement->appendChild( $folder );
            }
        else
            {
            $xml_doc->findnodes ( "//folder[\@id=$result->{parent}]" )->pop()->appendChild( $folder );
            }
        }

    # set the current active folder
    my @current_folder = $xml_doc->findnodes( "//folder[\@id=$cur_folder_id]" ) if $cur_folder_id;

    if ( @current_folder )
        {
        $current_folder[0]->setAttribute( "is_current", 1);
        }

    warn "Generated folder tree XML: " . $xml_doc->toString() if DEBUG > 3;
    return $xml_doc;
    }

######################################################################
# obtain the complete analysis history for a specified root dataset (by id)
######################################################################
sub
get_analysis_history
    {
    my ( $session ) = @_;

    my $dbh = $EP::Config::h->{DBH};
    my $sth_analysis_history_tree = $dbh->prepare( "select * from ep_action_view where root_dataset = ? order by id" );

    my $current_root_dataset_id = $session->current_root_dataset->id if $session->current_root_dataset;
    my $rc_analysis_history_tree  = $sth_analysis_history_tree->execute( $current_root_dataset_id );

    my $analysis_history_xml = build_analysis_history_xml( $sth_analysis_history_tree, $session->current_root_dataset, $session->current_action );

    return $analysis_history_xml;
    }

sub
generate_action_node_xml
    {
    my ( $actions_ref, $current_action_id ) = @_;
    my $xml = "";

    foreach my $action_id ( sort( keys %{$actions_ref->{children}} ) )
        {
        my $action = $actions_ref->{children}{$action_id};
        my $dst_dataset_props = "";
        while ( my ( $type, $value ) = each %{ $action->{dst_dataset_metadata} } )
            {
            if ( $type =~ /histogram|lineplot|heatmap|legend/ )
                {
                $dst_dataset_props .= qq( $type="$EP::Config::h->{EPNG_USRDATA_URL}/$action->{dst_dataset_location}/$value");
                }
            else
                {
                $dst_dataset_props .= qq( $type="$value") if defined $type;
                }
            }

        my $dst_dataset_filename = $EP::Config::h->{EPNG_USRDATA_URL} . "/" . $action->{dst_dataset_location} . "/" . $action->{dst_dataset_filename};

        # $action->{action_date} -- Dy Mon d HH24:MI:SS YYYY
        my ($date, $time, $year) = ($action->{action_date} =~ /... (.*) (.*):.. (.*)/);
        $date .= ", $year";

        # add is_current attribute to matching action
        my $is_current_prop = "";
        $is_current_prop = qq( is_current="1") if $current_action_id == $action_id;

        $xml .= qq(<action id="$action->{action_id}" epc_id="$action->{epc_id}" epc_name="$action->{epc_name}" date="$date" time="$time" dst_dataset_id="$action->{dst_dataset_id}" data_type="$action->{dst_dataset_type}" species="$action->{dst_dataset_species}"$dst_dataset_props$is_current_prop>);

        my @action_metadata =
            sort {
                my ($c1) = $a->{name} =~ /clustering_(\d+)/;
                my ($c2) = $b->{name} =~ /clustering_(\d+)/;
                $c1 = 0 if not defined $c1;
                $c2 = 0 if not defined $c2;
                return $c1 <=> $c2;
                }
            values %{ $action->{action_metadata} };

        foreach my $meta ( @action_metadata )
            {
            next if not $meta->{label};
            if ( ( $meta->{type} eq 'text/plain' and $meta->{name} =~ /clustering_\d+/ ) or $meta->{type} eq 'text/xml' )
                {
                $xml .= qq(<meta id="$meta->{id}" name="$meta->{name}" type="$meta->{type}" label="$meta->{label}">$meta->{value}</meta>);
                }
            }

        my @saved_clusters = grep { $_->{name} eq "saved_clusters" } @action_metadata;
        foreach my $sc ( @saved_clusters )
            {
            if ( 0 != grep { $_->{name} eq 'cols_clust' && $_->{uuid} eq $sc->{uuid} } @action_metadata )
                {
                my @saved_col_clusters = split /:/, $sc->{value} if $sc->{value};
                foreach ( @saved_col_clusters )
                    {
                    my ( $left, $right, $name, $leftmost, $rightmost, $count ) = split /,/, $_;
                    $xml .= qq(<savedcluster type="columns"  name="$name" left="$left" right="$right" leftmost="$leftmost" rightmost="$rightmost" count="$count"/>);
                    }
                }
            else
                {
                my @saved_row_clusters = split /:/, $sc->{value} if $sc->{value};
                foreach ( @saved_row_clusters )
                    {
                    my ( $left, $right, $name, $leftmost, $rightmost, $count ) = split /,/, $_;
                    $xml .= qq(<savedcluster type="rows"  name="$name" left="$left" right="$right" leftmost="$leftmost" rightmost="$rightmost" count="$count"/>);
                    }
                }
            }

        #iterate over children, then close the tag
        $xml .= generate_action_node_xml($action, $current_action_id);
        $xml .= qq(</action>);
        }

    return $xml;
    }

sub
put_action_on_tree
    {
    my ( $actions_ref, $action_ref ) = @_;

    if ( not defined $action_ref->{parent_action_id} )
        {
        $actions_ref->{children}->{$action_ref->{action_id}} = $action_ref;
        return 1;
        }

    foreach my $iter ( keys %{$actions_ref->{children}} )
        {
        if ($iter == $action_ref->{parent_action_id})
            {
            # voila, add new action as a child
            $actions_ref->{children}->{$iter}->{children}->{$action_ref->{action_id}} = $action_ref;
            return 1;
            }
        else
            {
            return if put_action_on_tree($actions_ref->{children}->{$iter}, $action_ref);
            }
        }
    return 0;
    }

sub
get_analysis_history_xml_string
    {
    my ( $session ) = @_;
    my $xml = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>";
    
    my $current_root_dataset_id = $session->current_root_dataset->id if $session->current_root_dataset;
    return $xml.qq(<analysis_history/>) if not defined $current_root_dataset_id or $current_root_dataset_id eq "";

    $xml .= qq(<analysis_history root_dataset_id="$current_root_dataset_id">);
    my $dbh = $EP::Config::h->{DBH};
    my $sth = $dbh->prepare("select * from ep_ext_action_view where root_dataset_id = ? order by action_id");

    my $rc  = $sth->execute($current_root_dataset_id);
    my $data = $sth->fetchall_arrayref({});
    return $xml.qq(</analysis_history>) if not ( my $data_size = scalar @$data );

    my $current_action_id = 0;
    $current_action_id = $session->current_action->id if $session->current_action;

    my $data_index = 0;

    my $action;
    my $root_of_actions;

    while ($data_index < scalar @$data)
        {
        my $row = @$data[$data_index++];

        # prepare the action object if new
        if ( not defined $action )
            {
            # first row will become a foundation for an object
            $action = $row;
            # adding empty array of children for cascading
            $action->{children} = {};
            }

        # this will initialize action tree
        $root_of_actions->{children} = {} if not defined $root_of_actions;

        $action->{dst_dataset_metadata} = {} if not exists $action->{dst_dataset_metadata};
        $action->{dst_dataset_metadata}->{ $row->{dataset_metadata_type} } = $row->{dataset_metadata_value}
            if defined $row->{dataset_metadata_type} and $row->{dataset_metadata_type} ne "";

        my $action_metadata =
            { id    => $row->{action_metadata_id}
            , type  => $row->{action_metadata_type}
            , label => $row->{action_metadata_label}
            , value => $row->{action_metadata_value}
            , uuid  => $row->{action_metadata_uuid}
            , name  => $row->{action_metadata_name}
            };

        $action->{action_metadata} = {} if not exists $action->{action_metadata};
        $action->{action_metadata}->{ $action_metadata->{id} } = $action_metadata
            if defined $action_metadata->{id} and not exists $action->{action_metadata}->{ $action_metadata->{id} };

        # if next exists and has different action id - 
        if ( ( $data_index < scalar @$data ) and ( $row->{action_id} != @$data[$data_index]->{action_id} ) )
            { # it'll will belong to another action, so place the action appropriately
            put_action_on_tree($root_of_actions, $action);
            undef $action;
            }
        }
    # put the last one on tree
    put_action_on_tree($root_of_actions, $action);
    undef $action;

    # so, traverse again through the tree and make the xml
    $xml .= generate_action_node_xml($root_of_actions, $current_action_id);
    $xml .= qq(</analysis_history>);

    return $xml;
    }
######################################################################
# builds the analysis history xml from the database records
######################################################################
sub build_analysis_history_xml {
  my ( $sth_analysis_history_tree, $root_dataset_id, $cur_actid ) = @_;

  my $xml_doc = XML::LibXML->createDocument();
  my $root = $xml_doc->createElement ( "analysis_history" );
  $root->setAttribute ( "root_dataset_id", $root_dataset_id );

  $xml_doc->setDocumentElement ( $root );
  return $xml_doc if not $sth_analysis_history_tree;

  my $latest_action_id = -1;
  while ( my ( $action_id, $parent_action_id, $root_dataset_id, $dst_dataset_id, $epc_id, $epc_name, $action_date, $action_metadata )
	  = $sth_analysis_history_tree->fetchrow_array () ) {
    my $action = $xml_doc->createElement ( "action" );
    $action->setAttribute ( "id",         $action_id   );
    $action->setAttribute ( "epc_id",     $epc_id      );
    $action->setAttribute ( "epc_name",   $epc_name    );
    $action->setAttribute ( "date",       $action_date );
    $action->setAttribute ( "dst_dataset_id", $dst_dataset_id  );
    $action->setAttribute ( "is_current", 0 );

    use EP::Common::DBI::Dataset;
    my $dst_dataset = EP::Common::DBI::Dataset->retrieve ( $dst_dataset_id );
    foreach my $meta ( $dst_dataset->metadata ) {
      $action->setAttribute ( $meta->type->name, $meta->values->first->value );

      # HACK - need to figure out how to provide access to histograms without coding in this DATA_WWW... more elegantly.
      if ( $meta->type->name =~ /histogram|lineplot/ ) {
	$action->setAttribute ( $meta->type->name, "$EP::Config::h->{EPNG_USRDATA_URL}/" . $dst_dataset->folder->location . "/" . $meta->values->first->value );
      }
    }

    my $dst_dataset_filename = $EP::Config::h->{EPNG_USRDATA_URL} . "/" . $dst_dataset->folder->location . "/" . $dst_dataset->filename;

    $action->setAttribute ( "data", "$EP::Config::h->{GET_DATA_HREF}?dataset_id=" . $dst_dataset->id );
    $action->setAttribute ( "rows", "$dst_dataset_filename.rows" );
    $action->setAttribute ( "cols", "$dst_dataset_filename.columns" );
    $action->setAttribute ( "selectrows", "$EP::Config::h->{SELECT_ITEMS_HREF}?select=rows&dataset_id=" . $dst_dataset->id );
    $action->setAttribute ( "selectcols", "$EP::Config::h->{SELECT_ITEMS_HREF}?select=cols&dataset_id=" . $dst_dataset->id );

    my $action_db = EP::Common::DBI::Action->retrieve ( $action_id );
    my @action_metadata = $action_db->metadata();

    foreach ( @action_metadata ) {
#      next if not $_->label;
#      next if not $_->type eq "xml/table";
      my $meta = $xml_doc->createElement("meta");
      $meta->setAttribute ( "id", $_->id );
      $meta->setAttribute ( "name", $_->name );
      $meta->setAttribute ( "type", $_->type || "" );
      $meta->setAttribute ( "uuid", $_->uuid || "" );
      $meta->setAttribute ( "label", $_->label || "" );
      $meta->appendChild ( $xml_doc->createTextNode ( $_->value ) ) if $_->value;
      $action->appendChild ( $meta );
    }

    my @saved_clusters = EP::Common::DBI::Action_Metadata->search ( { action => $action_id,
								      name => 'saved_clusters' } );

    foreach my $sc ( @saved_clusters ) {
      if ( EP::Common::DBI::Action_Metadata->search ( { action => $action_id,
							name => 'cols_clust',
							uuid   => $sc->uuid()
						      } ) ) {
	my @saved_col_clusters = split /:/, $sc->value if $sc->value;
	foreach ( @saved_col_clusters ) {
	  my $cluster = $xml_doc->createElement ( "cluster" );
	  my ( $left, $right, $name, $leftmost, $rightmost ) = split /,/, $_;
	  $cluster->setAttribute ( "id", $sc->id );
	  $cluster->setAttribute ( "left", $left );
	  $cluster->setAttribute ( "right", $right );
	  $cluster->setAttribute ( "name", $name );
	  $cluster->setAttribute ( "direction", "col" );
	  $action->appendChild ( $cluster );
	}
      } else {
	my @saved_row_clusters = split /:/, $sc->value if $sc->value;
	foreach ( @saved_row_clusters ) {
	  my $cluster = $xml_doc->createElement ( "cluster" );
	  my ( $left, $right, $name, $leftmost, $rightmost ) = split /,/, $_;
	  $cluster->setAttribute ( "id", $sc->id );
	  $cluster->setAttribute ( "left", $left );
	  $cluster->setAttribute ( "right", $right );
	  $cluster->setAttribute ( "name", $name );
	  $cluster->setAttribute ( "direction", "row" );
	  $action->appendChild ( $cluster );
	}
      }
    }

    $latest_action_id = $action_id;

    if ( not defined $parent_action_id or $parent_action_id eq "" ) {
      $xml_doc->documentElement->appendChild ( $action );
    } else {
      $xml_doc->findnodes ( "//action[\@id=$parent_action_id]" )->pop()->appendChild ( $action );
    }
  }

  if ( $latest_action_id != -1 ) {
    my @current_action = $xml_doc->findnodes ( "//action[\@id=$cur_actid]" ) if $cur_actid > 0;
    if ( @current_action ) {
      $current_action[0]->setAttribute ( "is_current", 1 );
    } else {
      @current_action = $xml_doc->findnodes ( "//action[\@id=$latest_action_id]" );
      $current_action[0]->setAttribute ( "is_current", 1 );
    }
  }

  return $xml_doc;
}

sub get_user_configuration {
  my ( $username, $propname ) = @_;

  warn "Who wants me?";

  my $sth = $EP::Config::h->{DBH}->prepare ( "select $propname from user_configuration where username = ?" );
  my $rc  = $sth->execute ( $username );

  warn $DBI::errstr and return 0 if !$rc;
  my ( $propvalue ) = $sth->fetchrow_array();

  return $propvalue;
}

sub set_user_configuration {
  my ( $username, $propname, $propvalue ) = @_;

  # try to update
  my $sth = $EP::Config::h->{DBH}->prepare ( "update user_configuration set $propname = ? where username = ?" );
  my $rc  = $sth->execute ( $propvalue, $username );

  if ( !$rc ) {
    warn "Couldn't set $propname to $propvalue for $username: " . $DBI::errstr if DEBUG;
    return 0;
  }

  return 1;
}

sub get_action_dst_dataset {
  my ( $action_id ) = @_;

  my $sth = $EP::Config::h->{DBH}->prepare ( "select dst_dataset from ep_action_view where id = ? " );
  my $rc  = $sth->execute ( $action_id );

  warn $DBI::errstr and return 0 if !$rc;
  my ( $dsid ) = $sth->fetchrow_array();

  return $dsid;
}

# insert into analysis_history:      /action_id/, /action_date/, component_id, dst_dataset_id, action_metadata
# insert into analysis_history_tree:  action_id, parent_action_id, root_dataset_id
# set current action_id to the one just created
sub record_analysis_history {
  my ( $parent_action_id, $component_id, $src_dataset_id, $dst_dataset_id, $action_metadata, $username ) = @_;

  my $dbh = $EP::Config::h->{DBH};

  my $sql;
  if ( ORACLE ) {
    $sql = "select action_seq.nextval from dual";
  } else {
    $sql = "select nextval('action_seq')";
  }

  my $root_dataset_id = $src_dataset_id;

  if ( $parent_action_id ) {
    ( $root_dataset_id ) = $dbh->selectrow_array ( "select root_dataset_id from analysis_history where action_id = ?", undef, $parent_action_id );
  }

  my ($new_action_id) = $dbh->selectrow_array ( $sql );
  my $sth = $dbh->prepare ( "insert into analysis_history ( action_id, parent_action_id, component_id, dst_dataset_id, root_dataset_id, action_metadata ) values (?,?,?,?,?,?)" );
  my $rc  = $sth->execute ( $new_action_id, $parent_action_id, $component_id, $dst_dataset_id, $root_dataset_id, $action_metadata );
  warn $DBI::errstr and return 0 if !$rc;

  $rc = $dbh->do ( "update user_configuration set current_action_id = ? where username = ?", undef, $new_action_id, $username );
  warn $DBI::errstr and return 0 if !$rc;

  $rc = $dbh->do ( "update user_configuration set current_root_dataset_id = ? where username = ?", undef, $root_dataset_id, $username );
  warn $DBI::errstr and return 0 if !$rc;

  return $new_action_id;
}

sub get_action {
  my ( $action_id ) = @_;

  my $dbh = $EP::Config::h->{DBH};
  my $sth = $dbh->prepare ( "select * from analysis_history_view where action_id = ?" );
  my $rc  = $sth->execute ( $action_id );
  warn $DBI::errstr and return 0 if !$rc;

  # unserialize action metadata
  my $action = $sth->fetchrow_hashref();
  $action->{action_metadata} = eval "my " . $action->{action_metadata};

  return $action;
}

sub get_latest_dataset_id_in_folder {
  my ( $folder_id ) = @_;

  my $dbh = $EP::Config::h->{DBH};
  my $sth = $dbh->prepare ( "select dataset_id from ep_dataset where folder_id=? and dataset_name is not null order by created desc" );
  my $rc  = $sth->execute ( $folder_id );
  warn $DBI::errstr and return 0 if !$rc;

  my ( $dataset_id ) =  $sth->fetchrow_array();
  return $dataset_id;
}

######################################################################
# Returns the complete data tree, consisting of users, folders,
# datasets and actions, nested in that order.
######################################################################
sub get_data_tree {
  my ( $username, $session_id, $cur_folder_id, $cur_root_dsid, $cur_actid ) = @_;

  my $SQL = <<__SQL__;
SELECT 	U.username,
        U.first_name,
        U.last_name,
        U.session_only,
	F.name AS folder_name,
        F.id   AS folder_id,
        F.parent AS parent_folder,
        F.location,
	D.id AS dataset_id,
        D.name AS dataset_name,
        D.created,
        D.description,
        D.filename,
        D.last_used,
        D.type,
        D.species,
        D.ep_session AS session_id,
	A.id AS action_id,
        A.parent_action,
        A.component_name,
        A.component,
        A.dst_dataset,
        A.ep_date,
        A.action_metadata
FROM ep_user U
INNER JOIN ep_folder F ON (F.owner=U.id)
LEFT OUTER JOIN ep_dataset D on (D.folder=F.id)
LEFT OUTER JOIN ep_action_view A on (A.root_dataset=D.id)
WHERE U.username = '$username'
ORDER BY F.id, D.id, A.ep_date ASC
__SQL__

  my ($root_folder) = $EP::Config::h->{DBH}->selectrow_array ( "select id from ep_folder where parent is null" );

  my $dbh = $EP::Config::h->{DBH};
  my $sth = $dbh->prepare ( $SQL );
  $sth->execute();

  my $dom = new XML::LibXML::Document;
  my $doc = $dom->createElement ( "userdata" );
  $dom->setDocumentElement ( $doc );

  while ( my $r = $sth->fetchrow_hashref() ) {
    my $user = $doc->findnodes ( "/userdata/user[\@username='$r->{username}']" )->pop();
    $user = append_new_user_node ( $dom, $doc, $r ) if not $user;

    my $folder = $user->findnodes ( ".//folder[\@id=$r->{folder_id}]" )->pop();
    $folder = append_new_folder_node ( $dom, $user, $root_folder, $r ) if not $folder;
    $folder->setAttribute ( "is_current", 1 ) if defined $cur_folder_id and $r->{folder_id} == $cur_folder_id;

    next if not $r->{dataset_id} or not defined $r->{dataset_name};
    next if ( $r->{session_only} and $r->{session_id} ne $session_id );
    my $dataset = $folder->findnodes ( "dataset[\@dataset_id=$r->{dataset_id}]" )->pop();
    $dataset = append_new_dataset_node ( $dom, $folder, $r ) if not $dataset;
    $dataset->setAttribute ( "is_current", 1 ) if defined $cur_root_dsid and $r->{dataset_id} == $cur_root_dsid;

    next if not $r->{action_id};
    my $action = $dataset->findnodes ( ".//action[\@action_id=$r->{action_id}]" )->pop();
    $action = append_new_action_node ( $dom, $dataset, $r ) if not $action;
    $action->setAttribute ( "is_current", 1 ) if defined $cur_actid and $r->{action_id} == $cur_actid;
  }

  return $doc;
}

sub append_new_user_node {
  my ( $dom, $doc, $r ) = @_;
  my $user = $dom->createElement ( "user" );
  setAttributes ( $user, $r, qw ( username first_name last_name ) );

  $doc->appendChild ( $user );

  return $user;
}

sub append_new_folder_node {
  my ( $dom, $user, $root_folder, $r ) = @_;
  my $folder = $dom->createElement ( "folder" );
  $folder->setAttribute ( "id",       $r->{folder_id} );
  $folder->setAttribute ( "name",     $r->{folder_name} );
  $folder->setAttribute ( "location", $r->{location} );

  my $parentElt;
  if ( $r->{parent_folder} == $root_folder ) {
    $parentElt = $user;
  } else {
    $parentElt = $user->findnodes ( ".//folder[\@id=$r->{parent_folder}]" )->pop();
  }

  my @folders = $parentElt->findnodes ( './folder' );
  if ( @folders ) {
    $parentElt->insertAfter ( $folder, $folders[$#folders] );
  } else {
    my $fc = $parentElt->firstChild();

    if ( $fc ) {
      $parentElt->insertBefore ( $folder, $fc );
    } else {
      $parentElt->appendChild ( $folder );
    }
  }

  return $folder;
}

sub append_new_dataset_node {
  my ( $dom, $folder, $r ) = @_;
  my $dataset = $dom->createElement ( "dataset" );
  setAttributes ( $dataset, $r, qw ( dataset_id dataset_name description type species filename session username created last_used ) );

  $dataset->setAttribute ( "data", "$EP::Config::h->{GET_DATA_HREF}?dataset_id=$r->{dataset_id}" );
  $dataset->setAttribute ( "rows", "$EP::Config::h->{EPNG_USRDATA_URL}/$r->{location}/$r->{filename}.rows" );
  $dataset->setAttribute ( "cols", "$EP::Config::h->{EPNG_USRDATA_URL}/$r->{location}/$r->{filename}.columns" );

  $dataset->setAttribute ( "selectrows", "$EP::Config::h->{SELECT_ITEMS_HREF}?select=rows&dataset_id=" . $r->{dataset_id} );
  $dataset->setAttribute ( "selectcols", "$EP::Config::h->{SELECT_ITEMS_HREF}?select=cols&dataset_id=" . $r->{dataset_id} );

  $folder->appendChild ( $dataset );

  return $dataset;
}

sub append_new_action_node {
  my ( $dom, $dataset, $r ) = @_;
  my $action = $dom->createElement ( "action" );
  setAttributes ( $action, $r, qw ( action_id dst_dataset component component_name date ) );

#  my $action_metadata = $dom->createCDATASection ( $r->{action_metadata} ) if ( defined $r->{action_metadata} and $r->{action_metadata} ne "OK" and $r->{action_metadata} ne "1" );
#  $action->appendChild ( $action_metadata ) if $action_metadata;

  my $action_db = EP::Common::DBI::Action->retrieve ( $r->{action_id} );
  my @action_metadata = $action_db->metadata();

  foreach ( @action_metadata ) {
    #      next if not $_->label;
    #      next if not $_->type eq "xml/table";
    my $meta = $dom->createElement("meta");
    $meta->setAttribute ( "id", $_->id );
    $meta->setAttribute ( "name", $_->name );
    $meta->setAttribute ( "type", $_->type || "" );
    $meta->setAttribute ( "uuid", $_->uuid || "" );
    $meta->setAttribute ( "label", $_->label || "" );
    $meta->appendChild ( $dom->createTextNode ( $_->value ) ) if $_->value;
    $action->appendChild ( $meta );
  }

  if ( not $r->{parent_action} ) {
    $dataset->appendChild ( $action );
  } else
    {
    my $found_dataset = $dataset->findnodes ( ".//action[\@action_id=$r->{parent_action}]" );
    if (defined $found_dataset)
        {
        my $aa = $found_dataset->pop();
        if (defined $aa)
            {
            $aa->appendChild ( $action );
            }
        }
    }

  return $action;
}

sub setAttributes {
  my ( $node, $of, @attrs ) = @_;

  foreach ( @attrs ) {
    $node->setAttribute ( $_, $of->{$_} ) if     defined $of->{$_};
    $node->setAttribute ( $_, "" )        if not defined $of->{$_};
  }
}

sub get_arrayexpress_experiments {
  my $ae_expts_xml = "$EP::Config::h->{TMP}/ae_experiments.xml";
  my $ae_expts_xsl = "$EP::Config::h->{TMP}/ae_experiments.xsl";
  my $xmlparser = new XML::LibXML;

  if ( -e $ae_expts_xml and -M $ae_expts_xml <= 1.0 ) {
    warn "Found cached file of AE expts: $ae_expts_xml, using that.";
    my $xmldoc = $xmlparser->parse_file ( $ae_expts_xml );
    $xmldoc->indexElements();
    return $xmldoc;
  }

  warn "Retrieving AE experiments data from the repository...";

  my $dbh = DBI->connect( $EP::Config::h->{AE_DB},
    			  $EP::Config::h->{AE_DBUSER},
			  $EP::Config::h->{AE_DBPASSWORD}, 
			  $EP::Config::h->{AE_DBATTR }
			) or die "Couldn't open connection to the database: $DBI::errstr\n";

  my $sh = $dbh->prepare ( <<__SQL__, { ora_auto_lob => 0 } );
select XmlElement ( "experiments",
           XmlAgg(
             XmlElement("experiment",
               XmlAttributes(i.identifier as "accnum", e.id as "id", i.name as "name"),
               XmlAgg(
                 XmlElement("description",
                   XmlAttributes(d.id as "id"),
                   d.text
                 )
               ),
              (select XmlElement ( "bioassaydatagroups",
                 XmlAgg (
                   XmlElement ( "bioassaydatagroup",
                     XmlAttributes ( i2.identifier as "name", badg.id as "id", count (badg.id) as "xxx",
                        (select count(bbb.bioassays_id) from TT_bioAssays_bioAssayDat bbb where bbb.bioassaydatagroups_id = badg.id) as "bioassay_count",
                        (select count(badg.id) from tt_derivedbioassaydata dbad, TT_bioAssayDat_bioAssayDat bb where bb.bioassaydatagroups_id = badg.id and dbad.id = bb.bioassaydatas_id and rownum=1) as "is_derived" )
                       )
                     )
                   )
                  from tt_bioassaydatagroup badg, TT_bioAssayDat_bioAssayDat bb, tt_bioassaydata bad, tt_identifiable i2
                  where
                  badg.experiment_id = e.id
                  and bb.bioassaydatagroups_id = badg.id
                  and bad.id = bb.bioassaydatas_id
                  and i2.id = bad.designelementdimension_id
                  group by badg.id, i2.identifier
                 )
               )
             )
           ).getClobVal()
   from tt_experiment e, tt_identifiable i, tt_description d, tt_extendable ext, pl_visibility v
   WHERE e.id = i.id and e.id = d.t_describable_id AND e.id=ext.id AND ext.label_id = v.label_id AND v.user_id=1
   GROUP BY e.id, i.identifier, i.name
__SQL__

  my $rc = $sh->execute ();
  my ($char_locator) = $sh->fetchrow_array ();

  my $chunk_size = 32767;   # Arbitrary chunk size, for example
  my $offset = 1;   # Offsets start at 1, not 0

  my $xml = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>";
  while ( my $data = $dbh->func ( $char_locator, $offset, $chunk_size, 'ora_lob_read' ) ) {
    $xml .= $data;
    $offset += $chunk_size;
  }

  die "Failed to retrieve datasets information from ArrayExpres" if sql_error ( $DBI::errstr ) == 1;

  $sh->finish;
  $dbh->disconnect;

  $xml =~ s/[\x01-\x08\x0b\x0c\x0e-\x1f]/\?/gm;  # just removing all control crap (except TAB and CRLF) to make sure parser won't fail

  my $xmldoc = $xmlparser->parse_string($xml);

  my $sorted_xml = new XML::LibXML::Document;
  my $sorted_xml_root = $sorted_xml->createElement ( "experiments" );
  $sorted_xml->setDocumentElement ( $sorted_xml_root );
  
  # sort received xml by accnum
  warn "Sorting the experiments...";
  my @sorted_experiments = sort {
    my $accnum1 = $a->findvalue ( '@accnum' ); 
    my $accnum2 = $b->findvalue ( '@accnum' );
    substr ( $accnum1, 2, 4 ) cmp substr ( $accnum2, 2, 4 )
    			      ||
    substr ( $accnum1, 7 )    <=> substr ( $accnum2, 7 );
  } $xmldoc->findnodes ( 'experiments/experiment' );
  
  warn "Extracting some metadata from generated descriptions";
  my %ae_species;
  my %ae_arrays;
  foreach ( @sorted_experiments ) {
    my $gen_desc = $_->findvalue ( 'description[contains(.,"(Generated description)")]' );
 
    my ( $species ) = $gen_desc =~ /species \[(.*?)\]/;
    $_->setAttribute ( "species", $species );

    my ( $array ) = $gen_desc =~ /array design \[(.*?)\]/;
    $_->setAttribute ( "array", $array );

    warn "Couldn't find species for experiment " . $_->findvalue ( '@accnum' ) if not $species;
    if ( $species && $species =~ /Organism:(.*)/ ) { $species = $1 };
    my @multi_species = split /, /, $species if $species;

    $ae_species{$_} = 1 foreach @multi_species;
#    $ae_arrays{$array} = 1 if $array;

    $sorted_xml_root->appendChild ( $_ );
  }

  my $xsl = $xmlparser->parse_file ( "$EP::Config::h->{HTML_ROOT}/static/xsl/format_ae_expts.xsl" );
  my ($ae_organism_filter) = $xsl->findnodes ( '//select[@id="ae_organism_filter"]' );
  $ae_organism_filter->removeChildNodes();

  foreach my $species_name ( "", sort keys %ae_species ) {
    my $option = $ae_organism_filter->addNewChild ( "", "option" );
    $option->setAttribute ( "value", $species_name );
    my $if = $option->addNewChild ( "", "xsl:if" );
    $if->setAttribute ( "test", "\$organism = '" . $species_name . "'" );
    $if->addNewChild ( "", "xsl:attribute" )->setAttribute ( "name", "selected" );
    $option->addChild ( $xsl->createTextNode ( $species_name ) ) if $species_name ne "";
    $option->addChild ( $xsl->createTextNode ( "No filter" ) ) if $species_name eq "";
  }

#  my ($ae_array_filter) = $xsl->findnodes ( '//select[@id="ae_array_filter"]' );
#  $ae_array_filter->removeChildNodes();
#
#  foreach my $array_name ( "", sort keys %ae_arrays ) {
#    my $option = $ae_array_filter->addNewChild ( "", "option" );
#    $option->setAttribute ( "value", $array_name );
#    my $if = $option->addNewChild ( "", "xsl:if" );
#    $if->setAttribute ( "test", "\$array = '" . $array_name . "'" );
#    $if->addNewChild ( "", "xsl:attribute" )->setAttribute ( "name", "selected" );
#    $option->addChild ( $xsl->createTextNode ( $array_name ) ) if $array_name ne "";
#    $option->addChild ( $xsl->createTextNode ( "No filter" ) ) if $array_name eq "";
#  }

  $xsl->toFile ( $ae_expts_xsl, 1 );
  
  warn "Caching " . scalar @sorted_experiments . " AE experiments to $ae_expts_xml";
  $sorted_xml->toFile($ae_expts_xml, 1);

  # index elements for faster Xpath in the future (if any)
  $sorted_xml->indexElements();
  return $sorted_xml;
}

1;
